Developer CD Series 1995 February: Tool Chest/Dev.CD Feb 95/Dev.CD Feb 95.toast/Sample Code/Pascal Sample 3.0B10/Source/SampleUtilities.inc1.p

Text File | 1993-10-13 | 22.6 KB | 659 lines | [TEXT/MPS ]

(******************************************************************************
*
*    Apple Macintosh Developer Technical Support
*
*    Code for the utility routines
*
*    Program:    Sample 3.0
*    FILE:        SampleUtilties.inc1.p - Pascal implementation
*
*    by:            Matt Deatherage
*
*    Copyright © 1988-1993 Apple Computer, Inc.
*    All rights reserved.
*
*******************************************************************************

(*******************************************************************************
* Routines in other files referenced by this code
*******************************************************************************)

PROCEDURE DoUpdate(window: WindowPtr);
    EXTERNAL;

PROCEDURE DoEvent(theEvent: EventRecord);
    EXTERNAL;

{$S Main}
(******************************************************************************
*
* Public: IsDAWindow
*
* Checks to see if a window belongs to a desk accessory.  All DAs have negative
* windowKind fields, so that's how we check (presuming it's not NIL).
*
******************************************************************************)

FUNCTION IsDAWindow(window: WindowPtr): BOOLEAN;

BEGIN
    IF window = NIL THEN
        IsDAWindow := FALSE
    ELSE                                 { DA windows have negative windowKinds }
        IsDAWindow := (WindowPeek(window)^.windowKind < 0);
END; {IsDAWindow}

{$S Main}
(******************************************************************************
*
* Public: IsAppWindow
*
* Checks to see if a window belongs to the application.  If the window pointer
* passed is NIL, it can't be an application window.  WindowKind values that are
* negative belong to the system, and all windowKind values less than userKind
* are reserved for Apple (except dialogKind, which means it's a dialog).
*
* We only return TRUE if the windowKind is equal to userKind.  If you add
* other kinds of windows to this application, you'll have to change how
* this routine works.
*
******************************************************************************)

FUNCTION IsAppWindow(window: WindowPtr): BOOLEAN;

BEGIN
    IF window = NIL THEN
        IsAppWindow := FALSE
    ELSE                 { application windows have windowKinds = userKind (8) }
        IsAppWindow := (WindowPeek(window)^.windowKind = userKind);
END; {IsAppWindow}

{$S Dialogs}
(******************************************************************************
*
* Public: ClassifyKey
*
* Takes an event record (presumed to contain a keypress event) and classifies
* the key within it on several criteria:  is it a digit, hex digit, letter,
* non-control key, command key, "accept" key (enter/return), "cancel" key
* (escape or Command-period), or an editing key?
*
* The parameter is a pointer to an event record.  This routine uses the
* not-well-known "short circuit" operators present in both MPW Pascal and
* THINK Pascal -- "&" for AND and "|" for OR.  The compiler evaluates
* both sides of the "&" or "|" expression, but as soon as it knows what
* the outcome will be it stops.  For example, "TRUE | FALSE" never evaulates
* FALSE, because it already knows the expression is TRUE because the first
* part was TRUE.  Similarly, "FALSE & TRUE" never evaulates TRUE.  Makes it
* look a bit like C.
*
******************************************************************************)

FUNCTION ClassifyKey(theEventPtr: EventRecordPtr): INTEGER;

VAR
    theFlags,                        { the flags we'll return }
    theChar: INTEGER;                { the character in question }

BEGIN
    theFlags := 0;                    { assume no characteristics }
    theChar := BAND(theEventPtr^.message, charCodeMask);
                                    { get the character from the record }

    { Is this an editing key? }

    IF (theChar = kDeleteKey) | (theChar = kLeftArrowKey) | (theChar =
       kRightArrowKey) | (theChar = kUpArrowKey) | (theChar = kDownArrowKey) |
       (theChar = kEscapeKey) | (theChar = kTabKey) THEN
        theFlags := BOR(theFlags, kEditKey);

    { Is it a digit?  If so, it's a hex digit also.  It's also not a letter,
    { cancel key or accept key, so don't bother checking }

    IF ((theChar >= ORD('0')) & (theChar <= ORD('9'))) THEN
        theFlags := BOR(theFlags, kDigitKey + kHexDigitKey)
    ELSE
        BEGIN
            IF ((theChar >= ORD('A')) & (theChar <= ORD('Z'))) |
               ((theChar >= ORD('a')) & (theChar <= ORD('z'))) THEN
                theFlags := BOR(theFlags, kLetterKey);

            IF ((theChar >= ORD('A')) & (theChar <= ORD('F'))) |
               ((theChar >= ORD('a')) & (theChar <= ORD('f'))) THEN
                theFlags := BOR(theFlags, kHexDigitKey);

            IF ((theChar = ORD('.')) & (BAND(theEventPtr^.modifiers,
               cmdKey) <> 0)) | (theChar = kEscapeKey) THEN
                theFlags := BOR(theFlags, kCancelKey);

            IF ((theChar = kReturnKey) | (theChar = kEnterKey)) THEN
                theFlags := BOR(theFlags, kAcceptKey);
        END;

    { Is this a control key? }

    IF (theChar > 31) THEN
        theFlags := BOR(theFlags, kNonControlKey);

    { Is the command key modifier down? }

    IF (BAND(theEventPtr^.modifiers, cmdKey) <> 0) THEN
        theFlags := BOR(theFlags, kCommandKey);

    ClassifyKey := theFlags;

END; { ClassifyKey }

{$S Main}
(******************************************************************************
*
* private: SampleAEIdleProc
*
* We need to pass an idle routine to AEInteractWithUser so that we can properly
* Handle activate, update and suspend/resume events (as well as other Apple
* events, maybe) while we wait.  This routine calls our main event handling
* routine for update, activate and OS events, and puts us to sleep for the
* maximum possible time when we get a NULL event, with no cursor handling.
*
******************************************************************************)

FUNCTION SampleAEIdleProc(VAR theEvent: EventRecord; VAR sleepTime: LONGINT;
                          VAR mouseRgn: RgnHandle): BOOLEAN;

BEGIN
    CASE theEvent.what OF
        updateEvt, activateEvt, osEvt:
            DoEvent(theEvent);
        nullEvent:
            BEGIN
                mouseRgn := NIL;          { no Cursor handling }
                sleepTime := MAXLONGINT; { we don't need lots of time, either }
            END;
        OTHERWISE;
    END;
    SampleAEIdleProc := FALSE;             { we're always willing to wait longer }
END;

{$S Main}
(******************************************************************************
*
* Public: OKToInteract
*
* We always call OKToInteract before we talk to the user, just to make sure
* it's fine to do so.  Even when the code we're executing can't directly be
* called via an Apple Event right now, it's still a good habit to get into
* so you don't find yourself talking to the user at inappropriate times
* in the future.  We also set up other user interaction parameters here,
* such as the arrow cursor.
*
* OKToInteract checks to see if there's currently an Apple Event being
* processed and, if there is, and there's a timeout value other than
* kAEDefaultTimeout and kNoTimeout, we set the timeout for _our_ call to
* AEInteractWithUser to 80% of their timeout.  While not foolproof, this mostly
* avoids the problem where someone asks us to, for example, print a file
* with a timeout of two minutes, but we wait forever to see if we can be
* brought to the front to do the printing job dialog.  The original event
* would time out, but we'd still be blinking the process menu and wouldn't
* go on until our application was the current one.  That's not good.
*
* We pass SampleAEIdleProc as the filter procedure, since that's why
* it's there.
*
******************************************************************************)

FUNCTION OKToInteract: BOOLEAN;

VAR
    myErr: OSErr;                        { error returned from various calls }
    canWeTalk: BOOLEAN;                    { signal that interaction is OK }
    theAEvent: AppleEvent;                { the current Apple event }
    theRealType: DescType;                { the type as returned by the AE Mgr }
    theTimeout: LONGINT;                { the timeout value }
    theRealSize: Size;                    { the real size of the parameter }

BEGIN
    canWeTalk := TRUE;                    { assume we can talk if no AE Mgr }
    IF gHasAppleEvents THEN
        BEGIN

            { Get the current event, and get the keyTimeoutAttr from it.
              If there's no event, or no timeout, we'll use a default
              timeout.  We get the timeout as a LONGINT, and it should
              never be longer than that so the cast always succeeds.  but
              we still have to pass variables to get the real descriptor
              type and the real size of the parameter -- we just ignore them. }

            myErr := AEGetTheCurrentEvent(theAEvent);
            myErr := AEGetAttributePtr(theAEvent, keyTimeoutAttr,
                                       typeLongInteger, theRealType,
                                       @theTimeout, 4, theRealSize);
            IF (myErr <> noErr) THEN
                theTimeout := kAEDefaultTimeout
            ELSE IF (theTimeout <> kAEDefaultTimeout) AND
                    (theTimeout <> kNoTimeout) THEN
                theTimeout := (LONGINT(theTimeout) DIV 5) * 4;
                                        { about 80% of the caller's value }

            myErr := AEInteractWithUser(theTimeout, NIL, @SampleAEIdleProc);
            canWeTalk := (myErr = noErr);
        END;

    IF canWeTalk THEN
        SetCursor(arrow);

    OKToInteract := canWeTalk;

END; { OKToInteract }

{$S Main}
(******************************************************************************
*
* Public: MustInteract
*
* This routine is very much like OKToInteract, but the timeout is always
* kNoTimeout.  This routine does not return until we can interact with the
* user.
*
* DoPromptSave requires this -- it's not acceptable to either overwrite a
* document on disk _or_ to lose changes when responding to an Apple Event.
* We must let the user decide what to do in that case.
*
******************************************************************************)

PROCEDURE MustInteract;

VAR
    myErr: OSErr;                        { error returned from various calls }

BEGIN

    IF gHasAppleEvents THEN
        myErr := AEInteractWithUser(kNoTimeout, NIL, @SampleAEIdleProc);

    SetCursor(arrow);

END; { MustInteract }

{$S Main}
(******************************************************************************
*
* Public: AskUser
*
* Asks the user about something, and returns TRUE if they selected the
* default Button (item #1).  The Alert resource ID is the passed parameter.
*
******************************************************************************)

FUNCTION AskUser(alertNum: INTEGER): BOOLEAN;

VAR
    itemHit: INTEGER;                    { the item the user selected }

BEGIN
    itemHit := 0;
    IF OKToInteract THEN
        BEGIN
            itemHit := Alert(alertNum, NIL);
        END;
    AskUser := (itemHit = 1);
END; {AskUser}

{$S Main}
(******************************************************************************
*
* Public: AlertUser
*
* Presents the user with an alert telling him something, then goes away.
* The resource ID of the alert is the passed parameter.  We ignore whatever
* button the user picks, because we don't care.
*
******************************************************************************)

PROCEDURE AlertUser(alertNum: INTEGER);

VAR
    itemHit: INTEGER;                    { the item the user selected }

BEGIN
    IF OKToInteract THEN
        BEGIN
            itemHit := Alert(alertNum, NIL);
        END;
END; { AlertUser }

{$S Main}
(******************************************************************************
*
* Public: UpdateAllAppWindows
*
* This routine walks through all the windows in the window list, and calls
* DoUpdate for each of them if they have anything at all to update.  DoUpdate
* takes no action if the window isn't an application window.  When this routine
* is done, none of our windows have any pending updates.
*
******************************************************************************)

PROCEDURE UpdateAllAppWindows;

VAR
    aWindow: WindowPtr;                        { the window to update }

BEGIN
    aWindow := FrontWindow;                    { start with the first window }
    WHILE aWindow <> NIL DO
        BEGIN

            { We only update a window if it has a non-empty update Region,
              so we don't do the Region manipulations in BeginUpdate and
              EndUpdate if not necessary }

            IF NOT EmptyRgn(WindowPeek(aWindow)^.updateRgn) THEN
                DoUpdate(aWindow);
            aWindow := GetNextWindow(aWindow);
        END;
END; { UpdateAllAppWindows }

{$S Main}
(******************************************************************************
*
* Public: DoPromptSave
*
* This routine presents an alert of the form "Save the <application name>
* document <theName> before <closing/quitting>?   Don't Save/cancel/Save".
* The action is either kClosing or kQuitting, and the return value is
* either kSave, kCancel or kDontSave.  We must be able to interact with
* the user, so we call MustInteract to delay until we can.  That might mean
* Apple Events which call us time out before we get a user's answer, but
* it's better to time out than to accidentally lose data.
*
******************************************************************************)

FUNCTION DoPromptSave(theName: Str63; theAction: INTEGER): INTEGER;

VAR
    appNameString: StringHandle;        { the name of our application }

BEGIN
    appNameString := GetString(kMissingAppNameStr);        { get our app name }
    ParamText(appNameString^^, theName, '', '');               { substitute it }
    MustInteract;                              { we MUST get the user's choice }
    DoPromptSave := Alert(rActionAlertBase+theAction, NIL);           { ask them }
    ReleaseResource(Handle(appNameString));          { and deallocate the memory }
END; { DoPromptSave }

{$S Main}
(******************************************************************************
*
* Public: HandleFileError
*
* This routine maps several common file system errors into alert IDs and
* presents error dialogs, or uses a generic dialog when no specific error
* message is available.  Most alerts also include the name of the document
* we were using, passed as the second parameter.  userCanceledErr is handled
* by ignoring it, so we can call this routine even when we aborted a file
* handling operation because of command-period or "cancel."
*
******************************************************************************)

PROCEDURE HandleFileError(myErr: OSErr; windTitle: Str255);

VAR
    tempErrString: Str255;                { the ASCII value of the error }
    myLongErr: LONGINT;                    { LONGINT copy for formal VAR params }

BEGIN
    myLongErr := myErr;
    NumToString(myLongErr, tempErrString);
    ParamText(tempErrString, windTitle, '', '');
    CASE myErr OF
        userCanceledErr: ;             { no action here, but not a weird error }
        ioErr:
            AlertUser(rIOError);
        opWrErr:
            AlertUser(rFileAlreadyOpen);
        permErr:
            AlertUser(rNoPermission);
        wPrErr:
            AlertUser(rDiskWriteProt);
        wrPermErr:
            AlertUser(rCantWriteFile);
        OTHERWISE
            BEGIN
                NumToString(myErr, tempErrString);
                ParamText(tempErrString, windTitle, '', '');
                AlertUser(rSomeWeirdError);
            END;
    END;
END; { HandleFileError }

{$S Main}
(******************************************************************************
*
* Public: CheckRequiredAEParms
*
* This routine uses AEGetAttributePtr to search for the missed keyword
* attribute, returning noErr if there isn't one (meaning we processed all
* required AE parameters) and returning errAEEVtNotHandled if there was one,
* because that means we missed a parameter.
*
******************************************************************************)

FUNCTION CheckRequiredAEParms(theAppleEvent: AppleEvent): OSErr;

VAR
    myErr: OSErr;                        { error from AE Manager calls }
    attrType: DescType;                    { the real descriptor type (ignored) }
    attrSize: Size;                        { the real attribute size (ignored) }

BEGIN
    myErr := AEGetAttributePtr(theAppleEvent, keyMissedKeywordAttr,
                               typeWildCard, attrType, NIL, 0, attrSize);
    IF myErr = errAEDescNotFound THEN
        myErr := noErr
    ELSE IF myErr = noErr THEN
        myErr := errAEEventNotHandled;
    CheckRequiredAEParms := myErr;
END; { CheckRequiredAEParms }

{$S Main}
(******************************************************************************
*
* Public: CreateWindowTitle
*
* This routine looks in the rUntitledStrings resource for either "untitled"
* (for the first window) or "untitled " (for the second and later windows) and
* uses them, along with ASCII conversions of window numbers (maintained by the
* gUntitledWindowCount global variable) to Create new "untitled" window titles
* as specified by Macintosh Human Interface Guidelines.
*
******************************************************************************)

PROCEDURE CreateWindowTitle(VAR theString: Str63);

VAR
    titleNumberStr,                        { string for the number of the window }
    untitledString: Str255;                { holds "untitled" or "untitled " }
    index: INTEGER;                        { which string do we fetch? }

BEGIN
    gUntitledWindowCount := gUntitledWindowCount + 1;
    IF gUntitledWindowCount > 1 THEN    { is this the first window? }
        BEGIN
            index := kUntitledWithSpaceString;
            NumToString(gUntitledWindowCount, titleNumberStr);
        END
    ELSE
        BEGIN
            titleNumberStr := '';
            index := kUntitledNoSpaceString;
        END;
    GetIndString(untitledString, rUntitledStrings, index);
    theString := concat(untitledString, titleNumberStr)
END; { CreateWindowTitle }

{$S Main}
(******************************************************************************
*
* Public: DoCopyResource
*
* This function to copy a resource between two files is pretty much taken
* from Inside Macintosh: Macintosh Toolbox Essentials, page 7-29.  That
* routine has more comments, but all the useful ones are here.
*
* This routine has one change -- it saves and restores the current resource
* file.  This is a utility routine, and the code which calls it doesn't
* necessarily expect the resource file to change after calling this routine.
* We also note that this routine does _not_ check to see that the resource
* being added to the destination file doesn't already exist -- if it does,
* you'll wind up with two resources of the same type and ID in the
* destination file.
*
******************************************************************************)

FUNCTION DoCopyResource(theType: ResType; theID, source, dest: INTEGER): OSErr;

VAR
    myHandle: Handle;                     { handle to resource to copy}
    myName: Str255;                     { name of resource to copy }
    myType: ResType;                     { ignored, used for GetResInfo }
    myID: INTEGER;                         { ignored, used for GetResInfo }
    oldResFile: INTEGER;                { the resource file on entry }

BEGIN
    oldResFile := CurResFile;            { save the original resource file }
    UseResFile(source);                 { set the source resource file}
    myHandle := GetResource(theType, theID); { open the source }
    IF myHandle <> NIL THEN
        BEGIN
            GetResInfo(myHandle, myID, myType, myName); { get resource name}
            DetachResource(myHandle);
            UseResFile(dest);            { set the destination resource file }
            AddResource(myHandle, theType, theID, myName);
            IF ResError = noErr THEN
                WriteResource(myHandle);{ write resource data}
        END;
    UseResFile(oldResFile);                { restore original resource file }
    DoCopyResource := ResError;         { return result code }
END;

{$S Main}
(******************************************************************************
*
* Public: DeviceLoopSim
*
* DeviceLoopSim was written by Forrest Tanaka for _develop_ #10, and simulates
* the DeviceLoop trap for systems that don't have it implemented.  This
* routine requires color QuickDraw.
*
* Forrest's routine calls a DeviceLoop drawing routine by function pointer,
* but it can do that because it's written in C.  Pascal can't, so we provide
* a nested routine to Handle calling a routine by pointer.
* CallDeviceLoopDrawingRoutine takes the same parameters, plus a function
* pointer as the last one, and is simply 68000 inline assembly code to Move
* the pointer into register A0 and jump through it.  Note that this would
* require changing for PowerPC machines to build a native Pascal application.
*
******************************************************************************)

PROCEDURE DeviceLoopSim(drawingRgn: RgnHandle; drawingProc: Ptr;
                        userData: LONGINT; flags: LONGINT);

        { local procedure to handle calling by pointer }

        PROCEDURE CallDeviceLoopDrawingRoutine(depth, deviceFlags: INTEGER;
                                               targetDevice: GDHandle;
                                               userData: LONGINT;
                                               theRoutine: Ptr);
            INLINE $205F, $4ED0;             { MOVEA.L (A7)+,A0; JMP (A0) }

    VAR
        aGDevice: GDHandle;            { Handle to the GDevice to draw in }
        screenRgn,                    { Region for each screen }
        savedClip: RgnHandle;        { saved clipRgn for the GrafPort }
        screenRect: Rect;            { rectangle for each screen's bounds }

    BEGIN
        savedClip := NewRgn;        { save the clip region of this port }
        GetClip(savedClip);

        screenRgn := NewRgn;
        aGDevice := GetDeviceList;
        WHILE aGDevice <> NIL DO
            BEGIN
                screenRect := aGDevice^^.gdRect;    { this screen's Rect }
                GlobalToLocal(screenRect.topLeft);    { make it local }
                GlobalToLocal(screenRect.botRight);
                RectRgn(screenRgn, screenRect);        { make a region of it }
                SectRgn(screenRgn, drawingRgn, screenRgn);
                                    { and intersect it with our drawing rgn }

                IF NOT EmptyRgn(screenRgn) THEN
                    BEGIN
                        SetClip(screenRgn);
                        CallDeviceLoopDrawingRoutine(aGDevice^^.gdPMap^^.
                                                     pixelSize,
                                                     aGDevice^^.gdFlags,
                                                     aGDevice, userData,
                                                     drawingProc);
                    END;
                aGDevice := GetNextDevice(aGDevice);
            END;
        SetClip(savedClip);            { restore the clip region }
        DisposeRgn(savedClip);        { and dispose of the two regions we made }
        DisposeRgn(screenRgn);
    END; { DeviceLoopSim }

{$S Print}
(******************************************************************************
*
* Public: NewPrJobMerge
*
* This routine is from Macintosh Technical Note "Fun with PrJobMerge" and
* works around a problem where LaserWriter 7.x can accidentally mess up your
* source print record as well as the destination one in PrJobMerge.  It
* allocates a new print record that's a copy of the source one and uses
* it as the source to PrJobMerge.
*
******************************************************************************)

    PROCEDURE NewPrJobMerge(hPrintSrc, hPrintDst: THPrint);

    VAR
        copyError: OSErr;            { error in creating new print record }
        hPrintTemp: THPrint;        { the temporary new print record }

    BEGIN
        hPrintTemp := hPrintSrc;    { copy the handle with this statement }
        copyError := HandToHand(Handle(hPrintTemp));
                                    { this makes a new handle with the same
                                      contents as the original }
        PrSetError(copyError);         { save this error for later}
        IF copyError = noErr THEN
            BEGIN
                { hPrintTemp is now a copy of the original source record }
                PrJobMerge(hPrintTemp, hPrintDst); { This may mess up
                                                     hPrintTemp, but we don't
                                                     care }
            END; {if copyError = noErr}
        IF hPrintTemp <> NIL THEN
            DisposeHandle(Handle(hPrintTemp));         { only a copy, remember!}
    END; { NewPrJobMerge }

{$S Main}
(******************************************************************************
*
* Public: GetNextWindow
*
* This function returns the window right after the one you pass in the
* window list.  It's named after an Apple IIgs toolbox function I always
* found incredibly handy which behaves identically.  The value is retrieved
* from the window record in question.
*
******************************************************************************)

    FUNCTION GetNextWindow(theWindow: WindowPtr): WindowPtr;

    BEGIN
        GetNextWindow := WindowPtr(WindowPeek(theWindow)^.nextWindow);
    END; { GetNextWindow }